home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Den Norske Hjemmedataklubben / Amiga-Hack 93-1 (1993)(Data-Tronic AS)(NO)(Disk 2 of 2)[b dump].zip / Amiga-Hack 93-1 (1993)(Data-Tronic AS)(NO)(Disk 2 of 2)[b dump].adf / PICSAVER / PICSAVER.ASM < prev    next >
Assembly Source File  |  1992-12-15  |  37KB  |  1,499 lines
  1. *    PicSaver
  2. *    By Preben Nielsen
  3. *
  4. *      This is a little utility that lets you cut-out a rectangular
  5. *    piece of any screen much in the save way as brushes are cut-out
  6. *    in Deluxe Paint and other paint-programs. The piece can then be
  7. *    saved on disk as an IFF-ILBM file (can then be used in most
  8. *    paint-programs).
  9. *
  10. *    NOTE:    There's no need to 'RUN' or 'RUNBACK' this program from the
  11. *        CLI. It is auto-detaching.
  12. *
  13. *HISTORY
  14. *          Made with Hisoft V2.12
  15. *
  16. *  V1.0   26-Mar-91: Can now draw/resize/erase the rectangle correctly.
  17. *         26-Mar-91: Now it opens a window.
  18. *         27-Mar-91: Saving screen as IFF-ILBM now works. (Unbuffered Output)
  19. *         28-Mar-91: Cleaned up a bit.
  20. *         31-Mar-91: Added the cross-hair. Still unbuffered Output !
  21. *         31-Mar-91: Drawing rectangles was not perfect. When the rectangle
  22. *                    is only one pixel on either side, it became invisible
  23. *                    because I drew the same line twice in 'Complement' mode.
  24. *                    Now I only draw one line in these cases.
  25. *         05-Apr-91: Added 'AutoRequester'.
  26. *         06-Apr-91: Added a few features. You can now easily save a window
  27. *                    or an entire screen. Also little change in the
  28. *                    'SaveILBM' routine.
  29. *  V1.1   19-May-91: Help, I just found out that my "TellInputDevice"
  30. *                    routine trashes memory-address 0 because it didn't
  31. *                    do a "NewList" on its Message-port. It didn't cause
  32. *                    any problems most of the time, but it has now been
  33. *                    cured.
  34.  
  35.                    
  36.     OPT O+
  37.     OPT O1+            ; Tells when a branch could be optimised to short
  38.     OPT i+            ; Tells when '#' is probably missing
  39.  
  40.         incdir        "AsmInc:"
  41.         include        "exec/exec_lib.i"
  42.         include        "exec/io.i"
  43.         include        "exec/memory.i"
  44.         include        "exec/interrupts.i"
  45.         include        "devices/input.i"
  46.         include        "devices/inputevent.i"
  47.         include        "libraries/dosextens.i"
  48.         include        "libraries/dos_lib.i"
  49.         include        "graphics/graphics_lib.i"
  50.         include        "intuition/intuition_lib.i"
  51.         include        "intuition/intuition.i"
  52.         include        "intuition/intuitionbase.i"
  53.  
  54. * These are the signals sent from the input-handler to the process
  55. SIGBASE        =20
  56. QUAL_RELEASE_B    =SIGBASE
  57. QUAL_PRESS_B    =SIGBASE+1
  58. LMB_RELEASE_B    =SIGBASE+2
  59. LMB_PRESS_B    =SIGBASE+3
  60. MOVE_B        =SIGBASE+4
  61. WINDOW_B    =SIGBASE+5
  62. SCREEN_B    =SIGBASE+6
  63. QUIT_B        =SIGBASE+7
  64. PORT_B        =SIGBASE+8
  65. QUAL_RELEASE_F    =1<<QUAL_RELEASE_B
  66. QUAL_PRESS_F    =1<<QUAL_PRESS_B
  67. LMB_RELEASE_F    =1<<LMB_RELEASE_B
  68. LMB_PRESS_F    =1<<LMB_PRESS_B
  69. MOVE_F        =1<<MOVE_B
  70. WINDOW_F    =1<<WINDOW_B
  71. SCREEN_F    =1<<SCREEN_B
  72. QUIT_F        =1<<QUIT_B
  73. PORT_F        =1<<PORT_B
  74. WaitMask    =QUAL_RELEASE_F|LMB_RELEASE_F|LMB_PRESS_F|MOVE_F|WINDOW_F|SCREEN_F|QUIT_F|QUAL_PRESS_F
  75.  
  76. RECTANGLE    =0
  77. CROSSHAIR    =1
  78. DISABLED    =2
  79.  
  80. FileBufSIZE    =50
  81.  
  82. Prepare        MACRO
  83.         IFC        '\1','Exec_Call'
  84.         movea.l        4.W,A6
  85.         ENDC
  86.         IFC        '\1','Intuition_Call'
  87.         movea.l        IntBase(DB),A6
  88.         ENDC
  89.         IFC        '\1','Gfx_Call'
  90.         movea.l        GfxBase(DB),A6
  91.         ENDC
  92.         IFC        '\1','Dos_Call'
  93.         movea.l        DosBase(DB),A6
  94.         ENDC
  95.         ENDM
  96. CallLib        MACRO
  97.         jsr        _LVO\1(A6)
  98.         ENDM
  99. Call        MACRO
  100.         bsr        \1
  101.         ENDM
  102. CallS        MACRO
  103.         bsr.S        \1
  104.         ENDM
  105. Push        MACRO
  106.         movem.l        \1,-(SP)
  107.         ENDM
  108. Pop        MACRO
  109.         movem.l        (SP)+,\1
  110.         ENDM
  111. rAPtr        MACRO        name
  112. DefSiz        set        DefSiz+4
  113. DefPtr        set        DefPtr-4
  114. \1        =        DefPtr
  115.         ENDM
  116. rLong        MACRO        name
  117. DefSiz        set        DefSiz+4
  118. DefPtr        set        DefPtr-4
  119. \1        =        DefPtr
  120.         ENDM
  121. rWord        MACRO        name
  122. DefSiz        set        DefSiz+2
  123. DefPtr        set        DefPtr-2
  124. \1        =        DefPtr
  125.         ENDM
  126. rByte        MACRO        name
  127. DefSiz        set        DefSiz+1
  128. DefPtr        set        DefPtr-1
  129. \1        =        DefPtr
  130.         ENDM
  131. rStorage    MACRO        name,size    ; Define storage
  132. DefSiz        set        DefSiz+\2
  133. DefPtr        set        DefPtr-\2
  134. \1        =        DefPtr
  135.         ENDM
  136. rEVEN        MACRO                ; Word boundary
  137.         IFNE        DefPtr&1
  138. DefPtr        set        DefPtr-1
  139. DefSiz        set        DefSiz+1
  140.         ENDC
  141.         ENDM
  142. rStart        MACRO                ; Define var section
  143. DefPtr        set        0
  144. DefSiz        set        0
  145.         ENDM
  146. rEnd        MACRO                ; End var section
  147. RelSize        =        DefSiz
  148.         ENDM
  149. rAlloc        MACRO                ; Allocate vars
  150.         link        DB,#-RelSize
  151.         ENDM
  152. rFree        MACRO                ; Deallocate vars
  153.         unlk        DB
  154.         ENDM
  155. rClear        MACRO                ; Reset all vars
  156.         movem.l        D0/DB,-(SP)
  157.         move.w        #RelSize-1,D0
  158. rClr.\@        clr.b        -(DB)
  159.         dbf        D0,rClr.\@
  160.         movem.l        (SP)+,D0/DB
  161.         ENDM
  162. Gadget        MACRO
  163.         dc.l        \1
  164.         dc.w        \2,\3,\4,\5,\6,\7,\8
  165.         ENDM
  166. Gadget2        MACRO
  167.         dc.l        \1,\2,\3,\4,\5
  168.         dc.w        \6
  169.         dc.l        \7
  170.         ENDM
  171. Border        MACRO
  172.         dc.w        \1,\2
  173.         dc.b        \3,\4,\5,\6
  174.         dc.l        \7,\8
  175.         ENDM
  176. Image        MACRO
  177.         dc.w        \1,\2,\3,\4,\5
  178.         dc.l        \6
  179.         dc.b        \7,\8
  180.         dc.l        \9
  181.         ENDM
  182. IntuiText    MACRO
  183.         dc.b        \1,\2,\3,0
  184.         dc.w        \4,\5
  185.         dc.l        TxtAttr,\6,\7
  186.         ENDM
  187. Detach        MACRO        ; Detach <'process name'>,stacksize,processpri
  188.         SECTION        SingleSplit,CODE
  189. Start        Prepare        Exec_Call
  190.         suba.l        A1,A1
  191.         CallLib        FindTask        ; Find us
  192.         move.l        D0,A2
  193.         tst.l        pr_CLI(A2)
  194.         bne.S        SegSplit
  195.         jmp        ProcessStart        ; from WorkBench
  196. SegSplit    CallLib        Forbid            ; From Dos
  197.         lea        DName(PC),A1
  198.         CallLib        OldOpenLibrary
  199.         move.l        D0,D5
  200.         beq.S        3$
  201.         moveq        #ML_SIZE+1*ME_SIZE,D0
  202.         move.l        #MEMF_PUBLIC|MEMF_CLEAR,D1
  203.         CallLib        AllocMem        ; Allocate Memlist
  204.         move.l        D0,A2
  205.         tst.l        D0
  206.         beq.S        2$
  207.         move.l        #ProcessName,D1
  208.         moveq        #\3,D2            ; Priority
  209.         move.l        Start-4(PC),D3
  210.         move.l        #\2,D4            ; StackSize
  211.         move.l        D5,A6
  212.         CallLib        CreateProc
  213.         Prepare        Exec_Call
  214.         tst.l        D0
  215.         beq.S        1$
  216.         move.l        D0,A0
  217.         lea        -pr_MsgPort(A0),A0    ; Now we have process
  218.         not.l        pr_CLI(A0)        ; All MY programs will now think they were started from the CLI
  219.         lsl.l        #2,D3
  220.         subq.l        #4,D3
  221.         move.l        D3,A1
  222.         move.w        #1,ML_NUMENTRIES(A2)    ; MemList -> ml_NumEntries    = 1
  223.         move.l        A1,ML_ME+ME_ADDR(A2)    ; MemList -> ml_me[0].me_Addr    = Segment
  224.         move.l        (A1),ML_ME+ME_LENGTH(A2); MemList -> ml_me[0].me_Length    = Length
  225.         lea        TC_MEMENTRY(A0),A0
  226.         move.l        A2,A1
  227.         CallLib        AddTail            ; AddTail(&Process->pr_Task.tc_MemEntry,&MemList->ml_Node);
  228.         lea        Start-4(PC),A0
  229.         clr.l        (A0)            ; Split the segments
  230.         bra.S        2$
  231. 1$        move.l        A2,A1            ; CreateProc failed. Can't do anything then
  232.         moveq        #ML_SIZE+1*ME_SIZE,D0
  233.         CallLib        FreeMem
  234. 2$        move.l        D5,A1
  235.         CallLib        CloseLibrary
  236. 3$        CallLib        Permit
  237.         moveq        #0,D0
  238.         rts
  239. DName        dc.b        'dos.library',0
  240. ProcessName    dc.b        \1,0            ; CreateProc makes a copy of this name
  241.         SECTION        ProcessCode,CODE
  242. ProcessStart
  243.         ENDM
  244.  
  245. DB        EQUR        A4
  246.  
  247. InitProcess    Detach        <'PicSaver Process'>,4000,0
  248.         rAlloc                    ; Allocate memory for variables
  249.         rClear                    ; Clear the memory
  250.         lea        FileInfo(PC),A1
  251.         lea        FBuffer(DB),A2
  252.         move.l        A2,si_Buffer(A1)
  253.         move.w        #FileBufSIZE,si_MaxChars(A1)
  254.         Prepare        Exec_Call
  255.         suba.l        A1,A1
  256.         CallLib        FindTask        ; Find us
  257.         move.l        D0,PProcess(DB)
  258.         movea.l        D0,A2
  259.         tst.l        pr_CLI(A2)
  260.         bne.S        GetLibs
  261. WBStart        lea        pr_MsgPort(A2),A0
  262.         CallLib        WaitPort        ; wait for a message
  263.         lea        pr_MsgPort(A2),A0
  264.         CallLib        GetMsg            ; then get it
  265.         move.l        D0,WBMsg(DB)        ; save it for later reply
  266. GetLibs        CallLib        Forbid
  267.         lea        IHS+ihs_PortName(PC),A1
  268.         CallLib        FindPort
  269.         move.l        D0,D2
  270.         CallLib        Permit
  271.         tst.l        D2
  272.         beq.S        1$
  273.         move.l        D2,A1            ; PicSaver was already installed ! 
  274.         move.l        MP_SIGTASK(A1),A1
  275.         move.l        #QUIT_F,D0
  276.         CallLib        Signal            ; Signal task to quit and then exit
  277.         bra.S        Exit
  278. 1$        lea        DosName(PC),A1
  279.         CallLib        OldOpenLibrary
  280.         move.l        D0,DosBase(DB)
  281.         beq.S        Error
  282.         lea        GfxName(PC),A1
  283.         CallLib        OldOpenLibrary
  284.         move.l        D0,GfxBase(DB)
  285.         beq.S        Error
  286.         lea        IntName(PC),A1
  287.         CallLib        OldOpenLibrary
  288.         move.l        D0,IntBase(DB)
  289.         beq.S        Error
  290. * Allocate 9 signal-bits
  291.         moveq        #8,D2
  292. 2$        moveq        #SIGBASE,D0
  293.         add.w        D2,D0
  294.         CallLib        AllocSignal
  295.         dbf        D2,2$
  296.         bra.S        Main
  297.  
  298. Error
  299. Exit        Prepare        Exec_Call
  300. FreeInt        move.l        IntBase(DB),D0
  301.         beq.S        FreeGfx
  302.         move.l        D0,A1
  303.         CallLib        CloseLibrary
  304. FreeGfx        move.l        GfxBase(DB),D0
  305.         beq.S        FreeDos
  306.         move.l        D0,A1
  307.         CallLib        CloseLibrary
  308. FreeDos        move.l        DosBase(DB),D0
  309.         beq.S        ReplyWB
  310.         move.l        D0,A1
  311.         CallLib        CloseLibrary
  312. ReplyWB        move.l        WBMsg(DB),D2
  313.         beq.S        AllDone
  314.         CallLib        Forbid            ; We were started from WB
  315.         movea.l        D2,A1
  316.         CallLib        ReplyMsg        ; Reply WBMessage
  317. AllDone        rFree
  318.         moveq        #0,D0
  319.         rts
  320.  
  321. Main        bset        #DISABLED,Status(DB)
  322.         lea        IHS(PC),A0
  323.         lea        PSPrepIHS1(PC),A1
  324.         lea        PSPrepIHS2(PC),A2
  325.         Call        InstallHandler
  326.         beq.S        1$
  327.         moveq        #CANTINSTALL,D0
  328.         Call        CONMsg
  329.         bra.S        Error
  330. 1$        moveq        #INSTALLED,D0
  331.         Call        CONMsg
  332.         bclr        #DISABLED,Status(DB)
  333. EventLoop    moveq        #0,D0
  334.         move.l        Up(DB),D1
  335.         beq.S        1$
  336.         move.l        D1,A0
  337.         moveq        #0,D1
  338.         move.b        MP_SIGBIT(A0),D1
  339.         bset        D1,D0
  340. 1$        ori.l        #WaitMask,D0
  341.         Prepare        Exec_Call
  342.         CallLib        Wait
  343.         move.l        D0,D5
  344.         move.l        Up(DB),D1
  345.         beq        CheckIHS
  346.         move.l        D1,A0
  347.         moveq        #0,D0
  348.         move.b        MP_SIGBIT(A0),D0
  349.         btst        D0,D5
  350.         beq        CheckIHS
  351. GetNextMsg    move.l        Up(DB),D1        ; Recieved an IDCMP-message
  352.         beq        CheckIHS
  353.         move.l        D1,A0
  354.         Prepare        Exec_Call
  355.         CallLib        GetMsg
  356.         tst.l        D0
  357.         beq        CheckIHS
  358.         move.l        D0,A1
  359.         move.l        im_Class(A1),D2
  360.         move.l        im_IAddress(A1),A2
  361.         CallLib        ReplyMsg
  362.         cmp.l        #ACTIVEWINDOW,D2
  363.         beq.S        ActivateFS
  364.         cmp.l        #GADGETUP,D2
  365.         bne.S        GetNextMsg
  366. GJ        move.w        gg_GadgetID(A2),D0    ; GadgetID is offset from GJ
  367.         jmp        GJ(PC,D0.W)
  368. DoSave        Call        CloseW
  369.         move.l        WWindow(DB),D0
  370.         beq.S        1$
  371.         move.l        D0,A0
  372.         Prepare        Intuition_Call
  373.         CallLib        WindowToFront
  374.         clr.l        WWindow(DB)
  375. 1$        Call        SaveRect
  376.         beq.S        2$
  377.         suba.l        A0,A0
  378.         suba.l        A2,A2
  379.         lea        ITxtAUTOBody(PC),A1
  380.         lea        ITxtAUTOOk(PC),A3
  381.         moveq        #0,D0
  382.         moveq        #0,D1
  383.         move.w        #248,D2
  384.         moveq        #46,D3
  385.         Prepare        Intuition_Call
  386.         CallLib        AutoRequest
  387.         bra.S        DoCS
  388. 2$        suba.l        A0,A0
  389.         Prepare        Intuition_Call
  390.         CallLib        DisplayBeep
  391.         bra.S        DoCS
  392. DoCancel    Call        CloseW
  393. DoCS        bclr        #DISABLED,Status(DB)
  394.         bra        GetNextMsg
  395. ActivateFS    Prepare        Intuition_Call
  396.         lea        Gad1(PC),A0
  397.         move.l        PWindow(DB),A1
  398.         suba.l        A2,A2
  399.         CallLib        ActivateGadget
  400.         bra        GetNextMsg
  401.  
  402. CheckIHS
  403. TestQUIT    btst        #QUIT_B,D5
  404.         beq.S        TestMOUSE
  405. * User pressed the qualifiers + the 'Quit_Key'
  406.         Call        DrawIt
  407.         Call        CloseW            ; Close window if it is open
  408.         bset        #DISABLED,Status(DB)
  409.         moveq        #REMOVED,D7
  410.         lea        IHS(PC),A0
  411.         lea        PSEndIHS1(PC),A1
  412.         lea        PSEndIHS2(PC),A2
  413.         Call        RemoveHandler
  414.         beq.S        1$
  415.         moveq        #CANTREMOVE,D0
  416.         Call        CONMsg
  417.         bra        EventLoop        ; Help !!
  418. 1$        move.l        D7,D0
  419.         Call        CONMsg
  420.         bra        Exit            ; Hmm
  421. TestMOUSE    btst        #DISABLED,Status(DB)    ; Are most things disabled ?
  422.         bne        EventLoop
  423.  
  424. TestQ_PRESS    btst        #QUAL_PRESS_B,D5
  425.         beq.S        TestQ_RELEASE
  426. * User pressed the qualifiers
  427.         Prepare        Intuition_Call
  428.         move.l        ib_ActiveScreen(A6),D0
  429.         beq.S        TestQ_RELEASE
  430.         move.l        D0,A0
  431.         move.w        sc_MouseY(A0),D0
  432.         bmi.S        TestQ_RELEASE
  433.         move.w        sc_MouseX(A0),D1
  434.         bmi.S        TestQ_RELEASE
  435.         movem.w        D0-D1,ey(DB)        ; (x,y) >= (0,0)
  436.         move.w        sc_Width(A0),sw(DB)    ; Get starting point
  437.         move.w        sc_Height(A0),sh(DB)    ; Get screen width/height
  438.         move.l        A0,WScreen(DB)
  439.         lea        sc_RastPort(A0),A0    ; Get screen Rastport
  440.         move.l        A0,Rp(DB)
  441.         bset        #CROSSHAIR,Status(DB)
  442.         bclr        #RECTANGLE,Status(DB)
  443.         Call        DrawIt            ; Draw cross-hair
  444.  
  445. TestQ_RELEASE    btst        #QUAL_RELEASE_B,D5
  446.         beq.S        TestLMB_RELEASE
  447. * User released the qualifiers
  448.         Call        DrawIt            ; Erase cross-hair/rectangle
  449.         bclr        #CROSSHAIR,Status(DB)
  450.         bclr        #RECTANGLE,Status(DB)
  451.  
  452. TestLMB_RELEASE    btst        #LMB_RELEASE_B,D5
  453.         beq.S        TestLMB_PRESS
  454. * User released the LMB while holding down the qualifiers
  455.         Call        DrawIt            ; Erase cross-hair/rectangle
  456.         bclr        #CROSSHAIR,Status(DB)
  457.         bclr        #RECTANGLE,Status(DB)
  458.         movem.w        ey(DB),D0-D3
  459.         cmp.w        D0,D2
  460.         ble.S        1$
  461.         exg        D0,D2
  462. 1$        cmp.w        D1,D3
  463.         ble.S        2$
  464.         exg        D1,D3
  465. 2$        sub.w        D3,D1
  466.         sub.w        D2,D0
  467.         addq.w        #1,D1
  468.         addq.w        #1,D0
  469.         movem.w        D0-D3,ph(DB)
  470.         lea        RTitle(PC),A0
  471.         move.l        A0,PTitle(DB)
  472.         bra        ContactTheUser
  473.  
  474. TestLMB_PRESS    btst        #LMB_PRESS_B,D5
  475.         beq.S        TestMOVE
  476. * User pressed the LMB while holding down the qualifiers
  477.         Call        DrawIt            ; Erase cross-hair
  478.         bclr        #CROSSHAIR,Status(DB)
  479.         move.l        WScreen(DB),A0
  480.         move.w        sc_MouseY(A0),D0
  481.         bmi.S        TestMOVE
  482.         move.w        sc_MouseX(A0),D1
  483.         bmi.S        TestMOVE
  484.         movem.w        D0-D1,sy(DB)
  485.         movem.w        D0-D1,ey(DB)
  486.         bset        #RECTANGLE,Status(DB)
  487.         Call        DrawIt            ; Draw rectangle
  488.  
  489. TestMOVE    btst        #MOVE_B,D5
  490.         beq.S        TestWINDOW
  491. * User moved the mouse while holding down the qualifiers and the LMB
  492.         move.l        WScreen(DB),A0
  493.         move.w        sc_MouseY(A0),D0    ; If Y < 0
  494.         bge.S        1$
  495.         moveq        #0,D0            ; then Y = 0
  496. 1$        move.w        sc_MouseX(A0),D1    ; If X < 0
  497.         bge.S        2$    
  498.         moveq        #0,D1            ; then X = 0
  499. 2$        cmp.w        ey(DB),D0        ; Did mouse actually move ?
  500.         bne.S        3$
  501.         cmp.w        ex(DB),D1
  502.         beq.S        TestWINDOW
  503. 3$        Call        DrawIt            ; Erase old cross-hair/rectangle
  504.         movem.w        D0-D1,ey(DB)
  505.         Call        DrawIt            ; Draw new cross-hair/rectangle
  506.  
  507. TestWINDOW    btst        #WINDOW_B,D5
  508.         beq.S        TestSCREEN
  509. * User pressed the qualifiers + the 'Window_Key'
  510.         Call        DrawIt            ; Erase cross-hair/rectangle
  511.         bclr        #CROSSHAIR,Status(DB)
  512.         bclr        #RECTANGLE,Status(DB)
  513.         Prepare        Intuition_Call
  514.         move.l        ib_ActiveWindow(A6),D0
  515.         beq.S        TestSCREEN
  516.         move.l        D0,A0
  517.         movem.w        wd_LeftEdge(A0),D0-D1
  518.         move.w        D0,px(DB)
  519.         move.w        D1,py(DB)
  520.         move.w        wd_Width(A0),pw(DB)
  521.         move.w        wd_Height(A0),ph(DB)
  522.         move.l        wd_Flags(A0),D0
  523.         andi.w        #BACKDROP,D0
  524.         bne.S        ContactTheUser
  525.         move.l        A0,WWindow(DB)
  526.         lea        WTitle(PC),A0
  527.         move.l        A0,PTitle(DB)
  528.         bra.S        ContactTheUser
  529.  
  530. TestSCREEN    btst        #SCREEN_B,D5
  531.         beq.S        DoneTest
  532. * User pressed the qualifiers + the 'Screen_Key'
  533.         Call        DrawIt            ; Erase cross-hair/rectangle
  534.         bclr        #CROSSHAIR,Status(DB)
  535.         bclr        #RECTANGLE,Status(DB)
  536.         move.l        WScreen(DB),A0
  537.         movem.w        sc_LeftEdge(A0),D0-D1
  538.         move.w        D0,px(DB)
  539.         move.w        D1,py(DB)
  540.         move.w        sc_Width(A0),pw(DB)
  541.         move.w        sc_Height(A0),ph(DB)
  542.         lea        STitle(PC),A0
  543.         move.l        A0,PTitle(DB)
  544. ContactTheUser    Call        OpenW
  545.         beq        EventLoop
  546.         bset        #DISABLED,Status(DB)
  547.         bra        EventLoop
  548. DoneTest    bra        EventLoop
  549.  
  550. DrawIt        btst        #RECTANGLE,Status(DB)
  551.         bne.S        DoDraw
  552.         btst        #CROSSHAIR,Status(DB)
  553.         bne.S        DoDraw
  554.         rts
  555. DoDraw        Push        D0-D5/A0-A1/A6
  556.         Prepare        Gfx_Call
  557.         move.l        Rp(DB),A2
  558.         moveq        #2,D0
  559.         move.l        A2,A1
  560.         CallLib        SetDrMd
  561.         btst        #RECTANGLE,Status(DB)
  562.         bne.S        DrawRect
  563. DrawCross    moveq        #0,D0
  564.         move.w        ey(DB),D1
  565.         move.l        A2,A1
  566.         CallLib        Move
  567.         move.w        sw(DB),D0
  568.         move.w        ey(DB),D1
  569.         move.l        A2,A1
  570.         CallLib        Draw
  571.         move.w        ex(DB),D0
  572.         moveq        #0,D1
  573.         move.l        A2,A1
  574.         CallLib        Move
  575.         move.w        ex(DB),D0
  576.         move.w        sh(DB),D1
  577.         move.l        A2,A1
  578.         CallLib        Draw
  579.         bra.S        EndDrawIt
  580. DrawRect    move.w        sx(DB),D2    ; Always draw lines clockwice
  581.         move.w        ex(DB),D4
  582.         cmp.w        D2,D4
  583.         bge.S        1$
  584.         exg        D2,D4
  585. 1$        move.w        sy(DB),D3
  586.         move.w        ey(DB),D5
  587.         cmp.w        D3,D5
  588.         bge.S        2$
  589.         exg        D3,D5
  590. 2$        move.w        D2,D0
  591.         move.w        D3,D1
  592.         move.l        A2,A1
  593.         CallLib        Move
  594.         cmp.w        D2,D4        ; If same x-coordinate then only draw one line
  595.         bne.S        3$
  596.         move.w        D2,D0
  597.         move.w        D5,D1
  598.         move.l        A2,A1
  599.         CallLib        Draw
  600.         bra.S        EndDrawIt
  601. 3$        move.w        D4,D0
  602.         move.w        D3,D1
  603.         move.l        A2,A1
  604.         CallLib        Draw
  605.         cmp.w        D3,D5        ; If same y-coordinate then only draw one line
  606.         beq.S        EndDrawIt
  607.         move.w        D4,D0        ; Draw the rest of the rectangle
  608.         move.w        D5,D1
  609.         move.l        A2,A1
  610.         CallLib        Draw
  611.         move.w        D2,D0
  612.         move.w        D5,D1
  613.         move.l        A2,A1
  614.         CallLib        Draw
  615.         move.w        D2,D0
  616.         move.w        D3,D1
  617.         addq.w        #1,D1        ; Prevent 'round' corner
  618.         move.l        A2,A1
  619.         CallLib        Draw
  620. EndDrawIt    moveq        #1,D0
  621.         move.l        A2,A1
  622.         CallLib        SetDrMd
  623.         Pop        D0-D5/A0-A1/A6
  624.         rts
  625.  
  626. * Call:  A0 = where to put it, D0 = number, D1 = count
  627. DecStr        subq.w        #1,D1
  628.         bra.S        2$
  629. 1$        move.b        #' ',(A0)+
  630. 2$        dbf        D1,1$
  631.         moveq        #'0',D1
  632.         move.b        D1,(A0)+
  633.         ext.l        D0
  634. 3$        tst.l        D0
  635.         beq.S        4$
  636.         divu        #10,D0
  637.         swap        D0
  638.         add.w        D1,D0
  639.         move.b        D0,-(A0)
  640.         clr.w        D0
  641.         swap        D0
  642.         bra.S        3$
  643. 4$        rts
  644.  
  645.  
  646. * Open a window on the Workbench screen and bring it to the front
  647. OpenW        Push        D0-D7/A0-A6
  648.         move.w        pw(DB),D0
  649.         moveq        #4,D1
  650.         lea        TxtSize+6(PC),A0
  651.         Call        DecStr
  652.         move.w        ph(DB),D0
  653.         moveq        #4,D1
  654.         lea        TxtSize+13(PC),A0
  655.         Call        DecStr
  656.         moveq        #0,D0
  657.         move.l        WScreen(DB),A0
  658.         move.b        sc_BitMap+bm_Depth(A0),D0
  659.         moveq        #2,D1
  660.         lea        TxtSize+20(PC),A0
  661.         Call        DecStr
  662.         Prepare        Intuition_Call
  663.         lea        NW(PC),A0
  664.         CallLib        OpenWindow
  665.         move.l        D0,PWindow(DB)
  666.         beq.S        1$
  667.         move.l        D0,A0
  668.         move.l        wd_UserPort(A0),Up(DB)
  669.         move.l        PTitle(DB),A1
  670.         lea        ScrTitle(PC),A2
  671.         CallLib        SetWindowTitles
  672.         move.l        PWindow(DB),A0
  673.         move.l        wd_WScreen(A0),A0
  674.         CallLib        ScreenToFront
  675. 1$        tst.l        PWindow(DB)
  676.         Pop        D0-D7/A0-A6
  677.         rts
  678.  
  679. * Close the window on the Workbench screen if it is open
  680. CloseW        Push        D0-D7/A0-A6
  681.         Prepare        Intuition_Call
  682.         move.l        PWindow(DB),D0
  683.         beq.S        1$
  684.         move.l        D0,A0
  685.         lea        NW(PC),A1
  686.         movem.w        wd_LeftEdge(A0),D0-D1
  687.         movem.w        D0-D1,nw_LeftEdge(A1)
  688.         CallLib        CloseWindow
  689.         clr.l        Up(DB)
  690.         clr.l        PWindow(DB)
  691.         move.l        WScreen(DB),A0
  692.         CallLib        ScreenToFront
  693. 1$        Pop        D0-D7/A0-A6
  694.         rts
  695.  
  696. FHandle        EQUR        D5
  697. * Call: D0 = Msg-number
  698. CONMsg        Push        D0-D7/A0-A6
  699.         Prepare        Dos_Call
  700.         move.l        D0,D4
  701.         moveq        #0,D6
  702.         CallLib        Output
  703.         move.l        D0,FHandle
  704.         bne.S        1$
  705.         moveq        #1,D6
  706.         lea        CONName(PC),A0
  707.         move.l        A0,D1
  708.         move.l        #MODE_OLDFILE,D2
  709.         CallLib        Open
  710.         move.l        D0,FHandle
  711.         beq.S        2$
  712. 1$        moveq        #INFOMSG,D0
  713.         Call        SendMsg
  714.         move.l        D4,D0
  715.         Call        SendMsg
  716.         tst.l        D6
  717.         beq.S        2$
  718.         moveq        #127,D1
  719.         CallLib        Delay
  720.         move.l        FHandle,D1
  721.         CallLib        Close
  722. 2$        Pop        D0-D7/A0-A6
  723.         rts
  724.  
  725. * Call: D0 = Msg-number
  726. SendMsg        neg.l        D0
  727.         lsl.l        #1,D0
  728.         lea        MsgTable(PC),A0
  729.         add.w        0(A0,D0),A0
  730.         move.l        A0,D2
  731.         moveq        #-1,D3
  732. 1$        addq.l        #1,D3
  733.         tst.b        (A0)+
  734.         bne.S        1$
  735.         move.l        FHandle,D1
  736.         Prepare        Dos_Call
  737.         CallLib        Write
  738.         rts
  739.  
  740. INFOMSG        =0
  741. INSTALLED    =-1
  742. REMOVED        =-2
  743. CANTINSTALL    =-3
  744. CANTREMOVE    =-4
  745.  
  746. MsgText        MACRO
  747.         dc.w        \1-MsgTable
  748.         ENDM
  749. MsgTable    MsgText        Msg
  750.         MsgText        Msg1
  751.         MsgText        Msg2
  752.         MsgText        Msg3
  753.         MsgText        Msg4
  754.  
  755. CONName        dc.b        'CON:100/60/330/63/PicSaver',0
  756. Msg        dc.b        10,$9B,'0;33m PicSaver V1.1',10
  757.         dc.b        $9B,'0;31m 1991 by ',$9B,'0;33mPreben Nielsen',$9B,'0;31m',10,' ',0
  758. Msg1        dc.b        'has just been installed...',10,0
  759. Msg2        dc.b        'has just been removed...',10,0
  760. Msg3        dc.b        'Error: Cannot install handler',10,0
  761. Msg4        dc.b        'Error: Cannot remove handler',10,0
  762.         EVEN
  763.  
  764. rtsValue    EQUR        D7
  765. * This is general-purpose inputhandler removal-routine
  766. * It only needs an ihs with a port-name to remove the handler
  767. * Call:   A0 = ihs
  768. *      A1 = first ihs-installation-routine or NULL
  769. *      A2 = second ihs-installation-routine or NULL
  770. * Return: D0 = 0 means succes
  771. RemoveHandler    Push        D1/rtsValue/A0-A3/A6
  772.         moveq        #-1,rtsValue
  773.         move.l        A2,A3
  774.         move.l        A0,A2
  775.         move.l        A1,D1
  776.         beq.S        1$
  777.         jsr        (A1)        ; A0 = ihs
  778.         beq.S        2$
  779.         move.l        D0,A2
  780. 1$        move.l        A2,A0
  781.         Prepare        Exec_Call
  782.         moveq        #IND_REMHANDLER,D0
  783.         Call        TellInputDevice
  784.         move.l        D0,rtsValue
  785.         bne.S        2$
  786.         lea        ihs_Port(A2),A1
  787.         CallLib        RemPort
  788.         moveq        #0,D0
  789.         bra.S        3$
  790. 2$        moveq        #-1,D0
  791. 3$        move.l        A3,D1
  792.         beq.S        4$
  793.         move.l        A2,A0
  794.         jsr        (A3)        ; A0 = ihs, D0 = 0 means succes
  795. 4$        move.l        rtsValue,D0
  796.         Pop        D1/rtsValue/A0-A3/A6
  797.         rts
  798.  
  799. * This is general-purpose inputhandler installation-routine
  800. * It only needs an ihs with a port-name to install the handler
  801. * Call:   A0 = ihs
  802. *      A1 = first ihs-installation-routine or NULL
  803. *      A2 = second ihs-installation-routine or NULL
  804. * Return: D0 = 0 means succes
  805. InstallHandler    Push        D1/rtsValue/A0-A3/A6
  806.         moveq        #-1,rtsValue
  807.         move.l        A2,A3
  808.         move.l        A0,A2
  809.         move.l        A1,D1
  810.         beq.S        1$
  811.         jsr        (A1)        ; A0 = ihs
  812.         beq.S        2$
  813.         move.l        D0,A2
  814. 1$        move.l        A2,A0
  815.         moveq        #IND_ADDHANDLER,D0
  816.         Call        TellInputDevice
  817.         move.l        D0,rtsValue
  818.         bne.S        2$
  819.         lea        ihs_Port(A2),A1
  820.         lea        ihs_PortName(A2),A0
  821.         move.l        A0,MP+LN_NAME(A1)        ;MsgPort->mp_Node.ln_Name=Name;
  822.         clr.b        MP+LN_PRI(A1)            ;MsgPort->mp_Node.ln_Pri =0;
  823.         move.b        #NT_MSGPORT,MP+LN_TYPE(A1)    ;MsgPort->mp_Node.ln_Type=NT_MSGPORT;
  824.         move.b        #PA_IGNORE,MP_FLAGS(A1)        ;MsgPort->mp_Flags     =PA_IGNORE;
  825.         Prepare        Exec_Call
  826.         CallLib        AddPort
  827.         moveq        #0,D0
  828.         bra.S        3$
  829. 2$        moveq        #-1,D0
  830. 3$        move.l        A3,D1
  831.         beq.S        4$
  832.         move.l        A2,A0
  833.         jsr        (A3)        ; A0 = ihs, D0 = 0 means succes
  834. 4$        move.l        rtsValue,D0
  835.         Pop        D1/rtsValue/A0-A3/A6
  836.         rts
  837.  
  838. * Open the input device. Set up the I/O block to add or remove the
  839. * input handler, and send the request to the input device. Finally,
  840. * close the device
  841. * Call:   A0 = ihs
  842. *      D0 = Function to perform (IND_ADDHANDLER/IND_REMHANDLER)
  843. * Return: D0 = 0 means succes
  844. TellInputDevice    Push        D1-D2/rtsValue/A0-A3/A6
  845.         Prepare        Exec_Call
  846.         moveq        #-1,rtsValue
  847.         move.l        D0,D2
  848.         move.l        A0,A2
  849.         lea        IReq(DB),A0
  850.         moveq        #IOSTD_SIZE,D0
  851.         Call        MemClear
  852.         lea        IPort(DB),A0
  853.         moveq        #MP_SIZE,D0
  854.         Call        MemClear
  855.         move.l        A0,A3
  856.         move.b        #NT_MSGPORT,MP+LN_TYPE(A3)    ; mp_Node.ln_Type=NT_MSGPORT;
  857.         move.b        #PA_SIGNAL,MP_FLAGS(A3)        ; mp_Flags    =PA_SIGNAL;
  858.         moveq        #-1,D0
  859.         CallLib        AllocSignal
  860.         move.b        D0,MP_SIGBIT(A3)        ; mp_SigBit    =MPSigBit;
  861.         bmi.S        2$
  862.         suba.l        A1,A1
  863.         CallLib        FindTask
  864.         move.l        D0,MP_SIGTASK(A3)        ; mp_SigTask     =FindTask(0);
  865.         lea        MP_MSGLIST(A3),A0
  866.         NEWLIST        A0
  867.         lea        IReq(DB),A1
  868.         move.l        A3,IO+MN_REPLYPORT(A1)        ; ExtReq->io_Message.mn_ReplyPort   =taskReplyPort;
  869.         move.b        #NT_MESSAGE,IO+MN+LN_TYPE(A1)    ; ExtReq->io_Message.mn_Node.ln_Type=NT_MESSAGE;
  870.         lea        InputName(PC),A0        ; input.device
  871.         moveq        #0,D0                ; unit#
  872.         moveq        #0,D1                ; flags
  873.         CallLib        OpenDevice
  874.         tst.w        D0                ; flag: error if > 0
  875.         bne.S        1$
  876.         lea        IReq(DB),A1
  877.         move.w        D2,IO_COMMAND(A1)
  878.         lea        ihs_Interrupt(A2),A0
  879.         move.l        A0,IO_DATA(A1)
  880.         CallLib        DoIO
  881.         move.l        D0,rtsValue
  882.         lea        IReq(DB),A1
  883.         CallLib        CloseDevice
  884. 1$        move.b        MP_SIGBIT(A3),D0
  885.         CallLib        FreeSignal
  886. 2$        move.l        rtsValue,D0
  887.         Pop        D1-D2/rtsValue/A0-A3/A6
  888.         rts
  889.  
  890. * Call: A0    = Memory area
  891. *    D0:16 = Count
  892. MemClear    Push        D0-D1/A0
  893.         moveq        #0,D1
  894.         bra.S        2$
  895. 1$        move.b        D1,(A0)+
  896. 2$        dbf        D0,1$
  897.         Pop        D0-D1/A0
  898.         rts
  899.  
  900. * Call: A0   = Source
  901. *    A1   = Destination
  902. *    D0:16= Count
  903. MemCopy        Push        D0/A0-A1
  904.         bra.S        2$
  905. 1$        move.b        (A0)+,(A1)+
  906. 2$        dbf        D0,1$
  907.         Pop        D0/A0-A1
  908.         rts
  909.  
  910. * Each handler should have such a pair of installation-routine
  911. * The first one is passed to InstallHandler in A1 and it
  912. * is called immediately when entering InstallHandler
  913. * The second one is passed to InstallHandler in A2 and it
  914. * is called if installation of handler and message-port succeds
  915. * -----------------------------------------------------------------
  916. * Call:   A0 = ihs
  917. * Return: D0 has to point to ihs to be used when installation proceeds
  918. *      If D0 = 0 then installation is aborted
  919. PSPrepIHS1    Push        A0-A1
  920.         move.b        #PORT_B,ihs_Port+MP_SIGBIT(A0)    ;MsgPort->mp_SigBit     =MPSigBit;
  921.         move.l        PProcess(DB),ihs_Port+MP_SIGTASK(A0);MsgPort->mp_SigTask =FindTask(0);
  922.         move.l        #HandlerSize,ihs_Length(A0)    ; This will enable removal by other programs
  923.         lea        HandlerCode-IHS(A0),A1
  924.         move.l        A1,ihs_Interrupt+IS_CODE(A0)    ; HandlerBlock.HInterrupt.is_Code = Handler
  925.         move.l        DB,ihs_Interrupt+IS_DATA(A0)    ; HandlerBlock.HInterrupt.is_Data = DB
  926.         move.b        #HPRI,ihs_Interrupt+LN_PRI(A0)    ; HandlerBlock.HInterrupt.is_Node.ln_Pri = PRI
  927.         move.l        A0,D0
  928.         Pop        A0-A1
  929.         rts
  930. * Call:   A0 = ihs
  931. PSPrepIHS2    rts
  932.  
  933. * Each handler should have such a pair of ending-routine
  934. * The first one is passed to RemoveHandler in A1 and it
  935. * is called immediately when entering RemoveHandler
  936. * The second one is passed to RemoveHandler in A2 and it
  937. * is called if removal of handler and message-port succeds
  938. * -----------------------------------------------------------------
  939. * Call:   A0 = ihs
  940. * Return: D0 has to point to ihs to be used when removal proceeds
  941. *      If D0 = 0 then removal is aborted
  942. PSEndIHS1    Push        D1-D2/A0-A1/A6
  943.         Prepare        Exec_Call
  944.         CallLib        Forbid
  945.         lea        ihs_PortName(A0),A1
  946.         CallLib        FindPort
  947.         move.l        D0,D2
  948.         CallLib        Permit
  949.         move.l        D2,D0            ; Does Forbid/Permit destroy scratch-registers ?
  950.         Pop        D1-D2/A0-A1/A6
  951.         rts
  952. * Call:   A0 = ihs
  953. PSEndIHS2    rts
  954.  
  955. *====================== Input-handler start =========================
  956. ihs_Port    =0
  957. ihs_Interrupt    =MP_SIZE
  958. ihs_ID        =MP_SIZE+IS_SIZE
  959. ihs_Length    =MP_SIZE+IS_SIZE+4
  960. ihs_Flags    =MP_SIZE+IS_SIZE+8
  961. ihs_PortName    =MP_SIZE+IS_SIZE+10
  962.  
  963. ihs_Start    MACRO
  964.         dcb.b        MP_SIZE        ; Message-Port structure
  965.         dcb.b        IS_SIZE        ; Interrupt structure
  966.         dc.l        'P_IH'        ; ID
  967.         dc.l        0        ; Length of handler 
  968.         dc.w        0        ; Flags
  969.         dc.b        \1,0
  970.         EVEN
  971.         ENDM
  972.  
  973. HPRI        =51
  974. HDisabled    =0
  975. HNoExtRemoval    =1
  976.  
  977. * This is the handler-block
  978. IHS        ihs_Start    <'PicSaver V1.1 Port'>
  979. * Local variables
  980. Chain        dc.l        0
  981. * For each event in the event list:
  982. *  If we were waiting for this event then signal the task.
  983. * When all the events have been checked, return the event list so that
  984. * others can do their things.
  985. PEvent        EQUR    A3                ; Previous Event
  986. Event        EQUR    A5                ; This Event
  987. Signals        EQUR    D7
  988. Next        =ie_NextEvent
  989. Class        =ie_Class
  990. Code        =ie_Code
  991. Qual        =ie_Qualifier
  992. * These are the qualifier-keys the input-handler waits for
  993. QUALIFIERS    =IEQUALIFIER_LALT|IEQUALIFIER_LSHIFT|IEQUALIFIER_CONTROL
  994. * This is the key the input-handler exits on
  995. Quit_Key    =$45                    ; ESC
  996. Window_Key    =$11                    ; w
  997. Screen_Key    =$21                    ; s
  998.  
  999. * Call:  A0 = List of InputEvents, A1 = HandlerData
  1000. HandlerCode    Push        D1/Signals/A0-A1/PEvent/DB/Event/A6
  1001.         moveq        #0,Signals
  1002.         move.l        A1,DB
  1003.         move.w        IHS+ihs_Flags(PC),D0
  1004.         btst        #HDisabled,D0        ; Future feature
  1005.         bne        NoMoreEvents
  1006.         lea        Chain(PC),PEvent
  1007.         move.l        A0,Next(PEvent)
  1008. ieLoop        move.l        Next(PEvent),Event
  1009.         move.l        Event,D0
  1010.         beq        NoMoreEvents
  1011.         cmpi.b        #IECLASS_NULL,Class(Event)
  1012.         beq        DontRemove
  1013.         cmpi.b        #IECLASS_TIMER,Class(Event)
  1014.         beq        DontRemove
  1015.         move.w        Qual(Event),D0
  1016.         andi.w        #QUALIFIERS,D0
  1017.         cmp.w        #QUALIFIERS,D0
  1018.         bne        NoQual
  1019.         cmpi.b        #IECLASS_RAWKEY,Class(Event)
  1020.         bne.S        1$
  1021.         cmp.w        #Quit_Key,Code(Event)
  1022.         beq.S        DoQuit
  1023.         cmp.w        #Window_Key,Code(Event)
  1024.         beq.S        DoWindow
  1025.         cmp.w        #Screen_Key,Code(Event)
  1026.         beq.S        DoScreen
  1027.         bra.S        IsQual
  1028.         bra.S        DontRemove
  1029. 1$        btst        #DISABLED,Status(DB)
  1030.         bne.S        DontRemove
  1031.         cmpi.b        #IECLASS_RAWMOUSE,Class(Event)
  1032.         bne.S        DontRemove
  1033.         cmpi.w        #IECODE_LBUTTON,Code(Event)
  1034.         beq.S        DoStart
  1035.         cmpi.w        #IECODE_UP_PREFIX|IECODE_LBUTTON,Code(Event)
  1036.         beq.S        DoEnd
  1037.         move.w        Qual(Event),D0
  1038.             andi.w        #IEQUALIFIER_RELATIVEMOUSE,D0
  1039.         beq.S        DontRemove
  1040. DoMove        move.b        Status(DB),D0
  1041.         andi.b        #1<<RECTANGLE|1<<CROSSHAIR,D0
  1042.         beq.S        DontRemove
  1043.         bset        #MOVE_B,Signals
  1044.         bra.S        DontRemove
  1045. DoEnd        btst        #RECTANGLE,Status(DB)
  1046.         beq.S        DontRemove
  1047.         bset        #LMB_RELEASE_B,Signals
  1048.         bra.S        DontRemove
  1049. DoStart        bset        #LMB_PRESS_B,Signals
  1050.         bra.S        Remove
  1051. DoWindow    bset        #WINDOW_B,Signals
  1052.         bra.S        Remove
  1053. DoScreen    bset        #SCREEN_B,Signals
  1054.         bra.S        Remove
  1055. DoQuit        bset        #QUIT_B,Signals
  1056.         bra.S        Remove
  1057. IsQual        move.b        Status(DB),D0
  1058.         andi.b        #1<<RECTANGLE|1<<CROSSHAIR,D0
  1059.         bne.S        DontRemove
  1060.         bset        #QUAL_PRESS_B,Signals
  1061.         bra.S        DontRemove
  1062. NoQual        move.b        Status(DB),D0
  1063.         andi.b        #1<<RECTANGLE|1<<CROSSHAIR,D0
  1064.         beq.S        DontRemove
  1065.         bset        #QUAL_RELEASE_B,Signals
  1066. * Just move on to next Event
  1067. DontRemove    move.l        Event,PEvent
  1068.         bra        ieLoop
  1069. * Remove event from chain and move on to next Event
  1070. Remove        move.l        Next(Event),Next(PEvent)
  1071.         bra        ieLoop
  1072. * Lets return
  1073. NoMoreEvents    move.l        Signals,D0
  1074.         beq.S        1$
  1075.         Prepare        Exec_Call
  1076.         movea.l        PProcess(DB),A1
  1077.         CallLib        Signal
  1078. 1$        Pop        D1/Signals/A0-A1/PEvent/DB/Event/A6
  1079.         move.l        Chain(PC),D0        ; Return (shortened ?) chain
  1080.         rts
  1081. HandlerSize    =        *-IHS
  1082. *====================== Input-handler end ===========================
  1083.  
  1084. *====================== Picture-saver start =========================
  1085. PicScreen    =0
  1086. PicName        =4
  1087. PicX        =8
  1088. PicY        =10
  1089. PicWidth    =12
  1090. PicHeight    =14
  1091. PicCompression    =16
  1092. Pic_SIZE    =18
  1093.  
  1094. PicDefine    dc.l    0,0
  1095.         dc.w    0,0,0,0,0
  1096.  
  1097. SaveRect    Push        D0-D1/A0-A1
  1098.         lea        PicDefine(PC),A1
  1099.         lea        FBuffer(DB),A0
  1100.         move.l        A0,PicName(A1)
  1101.         move.l        WScreen(DB),PicScreen(A1)
  1102.         move.w        px(DB),PicX(A1)
  1103.         move.w        pw(DB),PicWidth(A1)
  1104.         move.w        py(DB),PicY(A1)
  1105.         move.w        ph(DB),PicHeight(A1)
  1106.         move.w        #1,PicCompression(A1)
  1107.         lea        PicDefine(PC),A0
  1108.         Call        SaveILBM
  1109.         Pop        D0-D1/A0-A1
  1110.         rts
  1111.  
  1112. ILBMHDSize    =20
  1113. BMHDSize    =20
  1114. ILBMHeader    dc.b        'FORM'
  1115.         dc.l        0
  1116.         dc.b        'ILBM'
  1117.         dc.b        'BMHD'
  1118.         dc.l        BMHDSize
  1119. BMHeader    dc.w        0,0    ; raster width, height in pixels
  1120.         dc.w        0,0    ; x,y pixel position for this image
  1121.         dc.b        0    ; # source bitplanes
  1122.         dc.b        0    ; masking
  1123.         dc.b        0    ; compression
  1124.         dc.b        0    ; unused; for consistency, put 0 here
  1125.         dc.w        0    ; transparent 'color number'
  1126.         dc.b        1,1    ; pixel aspect, a ratio width : height
  1127.         dc.w        0,0    ; source 'page' size in pixels
  1128. CAMGHDSize    =8
  1129. CAMGHeader    dc.b        'CAMG'
  1130.         dc.l        4
  1131.         dc.l        0
  1132. CMAPHDSize    =8
  1133. CMAPHeader    dc.b        'CMAP'
  1134.         dc.l        0
  1135. BODYHDSize    =8
  1136. BODYHeader    dc.b        'BODY'
  1137.         dc.l        0
  1138.  
  1139. * Call:   A0 = PicDefine
  1140. * Return: D0 = 0 means succes
  1141. SaveILBM    Push        D1-D7/A0-A6
  1142.         clr.l        Pic_Total(DB)
  1143.         move.l        PicScreen(A0),Pic_Screen(DB)
  1144.         move.l        PicName(A0),Pic_FileName(DB)
  1145.         move.w        PicCompression(A0),Pic_Compression(DB)
  1146.         move.w        PicX(A0),D0
  1147.         move.w        D0,Pic_x(DB)
  1148.         move.w        PicWidth(A0),D1
  1149.         move.w        D1,Pic_Width(DB)
  1150.         add.w        D1,D0
  1151.         move.w        D0,Pic_EndCol(DB)
  1152.         move.w        PicY(A0),D0
  1153.         move.w        D0,Pic_y(DB)
  1154.         move.w        PicHeight(A0),D1
  1155.         move.w        D1,Pic_Height(DB)
  1156.         add.w        D1,D0
  1157.         move.w        D0,Pic_EndRow(DB)
  1158.         move.w        Pic_x(DB),D0
  1159.         ext.l        D0
  1160.         divu        #8,D0
  1161.         move.w        D0,Pic_SkipBytes(DB)    ; How many bytes should I skip at the beginning of each row
  1162.         swap        D0
  1163.         move.w        D0,Pic_LShift(DB)    ; How often should I shift bits to the left
  1164.         move.w        Pic_Width(DB),D0    ; Calculate bytes per line (word aligned)
  1165.         add.w        #15,D0
  1166.         lsr.w        #3,D0
  1167.         bclr        #0,D0
  1168.         move.w        D0,Pic_BytesPerRow(DB)
  1169.         lsl.w        #3,D0
  1170.         sub.w        Pic_Width(DB),D0
  1171.         ext.l        D0
  1172.         moveq        #-1,D1
  1173.         lsl.w        D0,D1
  1174.         move.w        D1,Pic_EndMask(DB)    ; Bits to cut of at the end of each line
  1175.         move.l        Pic_Screen(DB),A0
  1176.         lea        sc_BitMap(A0),A1
  1177.         move.l        A1,Pic_BitMap(DB)
  1178.         move.b        bm_Depth(A1),Pic_Depth+1(DB)
  1179.         move.w        bm_BytesPerRow(A1),Pic_BMBytesPerRow(DB)
  1180.         lea        sc_ViewPort(A0),A1
  1181.         move.l        A1,Pic_ViewPort(DB)
  1182.         move.w        vp_Modes(A1),D0
  1183.         and.w        #V_HIRES|V_HAM|V_LACE,D0
  1184.         move.w        D0,Pic_ViewMode(DB)
  1185.         move.l        vp_ColorMap(A1),A1
  1186.         move.l        cm_ColorTable(A1),Pic_ColorTable(DB)
  1187.         lea        PBuffer1(DB),A0
  1188.         move.l        A0,Pic_ByteBuffer(DB)
  1189.         lea        PBuffer2(DB),A0
  1190.         move.l        A0,Pic_PackBuffer(DB)
  1191.         lea        BMHeader(PC),A0
  1192.         move.w        Pic_Width(DB),(A0)
  1193.         move.w        Pic_Height(DB),2(A0)
  1194.         move.w        Pic_Width(DB),16(A0)
  1195.         move.w        Pic_Height(DB),16+2(A0)
  1196.         move.b        Pic_Depth+1(DB),8(A0)
  1197.         move.b        Pic_Compression+1(DB),10(A0)
  1198.         Prepare        Dos_Call
  1199.         move.l        Pic_FileName(DB),D1
  1200.         move.l        #MODE_NEWFILE,D2
  1201.         CallLib        Open
  1202.         move.l        D0,Pic_FileHandle(DB)
  1203.         beq        NoPicFile
  1204.         lea        CAMGHeader(PC),A0
  1205.         move.w        Pic_ViewMode(DB),2+8(A0)
  1206.         lea        ILBMHeader(PC),A0    ; Write ILBM File Header
  1207.         moveq        #ILBMHDSize+BMHDSize+CAMGHDSize+4+CMAPHDSize-4,D0
  1208.         Call        WriteBytes
  1209.         bne        WriteError
  1210.         move.w        Pic_Depth(DB),D1
  1211.         moveq        #0,D3
  1212.         bset        D1,D3            ; Number of colours (2^depth)
  1213.         move.l        D3,D4
  1214.         mulu        #3,D4
  1215.         move.l        Pic_ByteBuffer(DB),A0    ; Write CMAP
  1216.         move.l        D4,(A0)+
  1217.         move.l        Pic_ColorTable(DB),A1
  1218.         moveq        #$F0-256,D5        ; Tricky way to make D5=FFF0
  1219.         bra.S        2$
  1220. 1$        move.w        (A1)+,D0        ; Copy colours into buffer
  1221.         move.w        D0,D1
  1222.         move.w        D0,D2
  1223.         lsr.w        #4,D0
  1224.         lsl.w        #4,D2
  1225.         and.w        D5,D0
  1226.         and.w        D5,D1
  1227.         and.w        D5,D2
  1228.         move.b        D0,(A0)+
  1229.         move.b        D1,(A0)+
  1230.         move.b        D2,(A0)+
  1231. 2$        dbra        D3,1$
  1232.         move.l        Pic_ByteBuffer(DB),A0
  1233.         move.l        D4,D0
  1234.         addq.l        #4,D0
  1235.         Call        WriteBytes
  1236.         bne        WriteError
  1237.         Call        WritePad        ; Unnecessary
  1238.         bne        WriteError
  1239.         move.l        Pic_Total(DB),Pic_BODYPos(DB)    ; We have to get back here
  1240.         lea        BODYHeader(PC),A0
  1241.         moveq        #BODYHDSize,D0
  1242.         Call        WriteBytes
  1243.         bne        WriteError
  1244.         move.w        Pic_y(DB),D7        ; Current row = D7
  1245.         subq.w        #1,D7
  1246. RowLoop        addq.w        #1,D7
  1247.         cmp.w        Pic_EndRow(DB),D7    ; Last row ?
  1248.         beq.S        DonePlanes
  1249.         move.l        Pic_BitMap(DB),A2
  1250.         lea        bm_Planes(A2),A2    ; Get pointer to bitplane
  1251.         move.w        Pic_Depth(DB),Pic_Looper(DB)
  1252. PlaneLoop    subq.w        #1,Pic_Looper(DB)
  1253.         bmi.S        RowLoop
  1254.         move.l        (A2)+,A0
  1255.         move.w        Pic_BMBytesPerRow(DB),D0; Offset
  1256.         mulu        D7,D0
  1257.         add.l        D0,A0
  1258.         add.w        Pic_SkipBytes(DB),A0    ; Skip some bytes
  1259.         move.l        Pic_ByteBuffer(DB),A1    ; Copy row to buffer
  1260.         move.w        Pic_BytesPerRow(DB),D0
  1261.         bra.S        2$
  1262. 1$        move.b        (A0)+,(A1)+
  1263. 2$        dbra        D0,1$
  1264.         moveq        #0,D2
  1265.         move.w        Pic_LShift(DB),D2    ; Shift bits to the left
  1266.         beq.S        NoPicShift
  1267.         move.l        Pic_ByteBuffer(DB),A0
  1268.         move.w        Pic_BytesPerRow(DB),D0
  1269.         addq.w        #1,D0            ; If you save byte alligned
  1270.         lsr.w        #1,D0
  1271.         bra.S        4$
  1272. 3$        move.l        (A0),D1            ; Copy four words to d1
  1273.         lsl.l        D2,D1            ; Now move bits of 2nd word into the 1st word
  1274.         swap        D1
  1275.         move.w        D1,(A0)+        ; Copy 1st word back to buffer
  1276. 4$        dbra        D0,3$
  1277.         move.w        Pic_EndMask(DB),D0
  1278.         and.w        D0,-(A0)
  1279. NoPicShift    moveq        #0,D0
  1280.         move.w        Pic_BytesPerRow(DB),D0
  1281.         cmp.w        #1,Pic_Compression(DB)
  1282.         bne.S        NotPacked
  1283.         Call        Packer
  1284. NotPacked    move.l        Pic_PackBuffer(DB),A0
  1285.         Call        WriteBytes
  1286.         bne.S        WriteError
  1287.         bra.S        PlaneLoop        ; Next bitplane
  1288. DonePlanes    Call        WritePad
  1289.         bne.S        WriteError
  1290.         move.l        Pic_FileHandle(DB),D1    ; Write BODY size
  1291.         move.l        Pic_BODYPos(DB),D2
  1292.         moveq        #OFFSET_BEGINNING,D3
  1293.         CallLib        Seek
  1294.         lea        BODYHeader(PC),A0
  1295.         move.l        Pic_Total(DB),D0
  1296.         sub.l        Pic_BODYPos(DB),D0
  1297.         subq.l        #BODYHDSize,D0
  1298.         move.l        D0,4(A0)
  1299.         moveq        #BODYHDSize,D0
  1300.         Call        WriteBytes
  1301.         bne.S        WriteError
  1302.         move.l        Pic_FileHandle(DB),D1    ; Write FORM size
  1303.         moveq        #0,D2
  1304.         moveq        #OFFSET_BEGINNING,D3
  1305.         CallLib        Seek
  1306.         lea        ILBMHeader(PC),A0
  1307.         move.l        Pic_Total(DB),D0
  1308.         sub.l        #8+BODYHDSize,D0
  1309.         move.l        D0,4(A0)
  1310.         moveq        #ILBMHDSize,D0
  1311.         Call        WriteBytes
  1312.         bne.S        WriteError
  1313.         move.l        Pic_FileHandle(DB),D1
  1314.         CallLib        Close
  1315.         moveq        #0,D0
  1316.         bra.S        DoneSaveILBM
  1317. WriteError    move.l        Pic_FileHandle(DB),D1
  1318.         CallLib        Close
  1319.         move.l        Pic_FileName(DB),D1
  1320.         CallLib        DeleteFile
  1321. NoPicFile    moveq        #-1,D0
  1322. DoneSaveILBM    tst.l        D0
  1323.         Pop        D1-D7/A0-A6
  1324.         rts
  1325.  
  1326. WritePad    btst        #0,Pic_Total+3(DB)
  1327.         beq.S        WRet
  1328.         move.l        Pic_ByteBuffer(DB),A0
  1329.         clr.b        (A0)
  1330.         moveq        #1,D0
  1331. * Write D0 bytes from A0
  1332. * A0 = Buffer, D0=Count
  1333. WriteBytes    move.l        Pic_FileHandle(DB),D1
  1334.         move.l        A0,D2
  1335.         move.l        D0,D3
  1336.         add.l        D0,Pic_Total(DB)
  1337.         CallLib        Write
  1338.         cmp.l        D3,D0
  1339. WRet        rts
  1340.  
  1341. Packer        Push        D1/A0-A3
  1342.         move.l        Pic_PackBuffer(DB),A0    ; A0=buffer
  1343.         move.l        Pic_ByteBuffer(DB),A1    ; A1=row
  1344.         move.l        A1,A3                
  1345.         add.w        Pic_BytesPerRow(DB),A3    ; A3=end of row
  1346. PackLoop    cmp.l        A3,A1
  1347.         bge.S        PackExit
  1348.         move.l        A1,A2
  1349. 1$        cmp.l        A3,A2
  1350.         bge.S        2$
  1351.         move.b        (A2)+,D0
  1352.         cmp.b        (A2),D0
  1353.         bne.S        1$
  1354.         subq.l        #1,A2
  1355. 2$        move.l        A2,D1
  1356.         sub.l        A1,D1
  1357.         beq.S        PackIt            ; Are there bytes between two parts of identical bytes
  1358.         subq.w        #1,D1            ; Code = n-1
  1359.         move.b        D1,(A0)+
  1360. 3$        move.b        (A1)+,(A0)+        ; Copy bytes
  1361.         dbra        D1,3$
  1362.         bra.S        PackLoop
  1363. PackIt        move.l        A1,A2
  1364. 1$        cmp.l        A3,A1
  1365.         beq.S        2$
  1366.         cmp.b        (A1)+,D0
  1367.         beq.S        1$
  1368.         subq.l        #1,A1
  1369. 2$        move.l        A1,D1
  1370.         sub.l        A2,D1
  1371.         neg.w        D1            ; Code = -n+1
  1372.         addq.w        #1,D1
  1373.         move.b        D1,(A0)+
  1374.         move.b        D0,(A0)+
  1375.         bra.S        PackLoop
  1376. PackExit    move.l        A0,D0
  1377.         sub.l        Pic_PackBuffer(DB),D0
  1378. 1$        Pop        D1/A0-A3
  1379.         rts
  1380.  
  1381.  
  1382. *====================== Picture-saver end ===========================
  1383.  
  1384. *====================== Data-definition start =======================
  1385.  rStart
  1386.  rAPtr        PProcess
  1387.  rAPtr        WBMsg
  1388.  rAPtr        DosBase
  1389.  rAPtr        GfxBase
  1390.  rAPtr        IntBase
  1391.  rAPtr        Rp
  1392.  rAPtr        Up
  1393.  rAPtr        WScreen
  1394.  rAPtr        WWindow
  1395.  rAPtr        PWindow
  1396.  rAPtr        PTitle
  1397.  rWord        Status
  1398.  rWord        sh
  1399.  rWord        sw
  1400.  rWord        sx
  1401.  rWord        sy
  1402.  rWord        ex
  1403.  rWord        ey
  1404.  rWord        px
  1405.  rWord        py
  1406.  rWord        pw
  1407.  rWord        ph
  1408.  rStorage    IReq,IOSTD_SIZE
  1409.  rStorage    IPort,MP_SIZE
  1410.  rStorage    FBuffer,FileBufSIZE
  1411.  
  1412.  rAPtr        Pic_FileName
  1413.  rAPtr        Pic_FileHandle
  1414.  rAPtr        Pic_ByteBuffer
  1415.  rAPtr        Pic_PackBuffer
  1416.  rLong        Pic_BODYPos
  1417.  rWord        Pic_x
  1418.  rWord        Pic_y
  1419.  rWord        Pic_Width
  1420.  rWord        Pic_Height
  1421.  rWord        Pic_EndCol
  1422.  rWord        Pic_EndRow
  1423.  rWord        Pic_Depth
  1424.  rWord        Pic_BytesPerRow
  1425.  rWord        Pic_BMBytesPerRow
  1426.  rWord        Pic_SkipBytes
  1427.  rWord        Pic_LShift
  1428.  rWord        Pic_EndMask
  1429.  rWord        Pic_ViewMode
  1430.  rWord        Pic_Compression
  1431.  rAPtr        Pic_Screen
  1432.  rAPtr        Pic_BitMap
  1433.  rAPtr        Pic_ViewPort
  1434.  rAPtr        Pic_ColorTable
  1435.  rWord        Pic_Looper
  1436.  rLong        Pic_Total
  1437.  rStorage    PBuffer1,164
  1438.  rStorage    PBuffer2,164
  1439.  rEnd
  1440.  
  1441. DosName        dc.b        'dos.library',0
  1442. GfxName        dc.b        'graphics.library',0
  1443. IntName        dc.b        'intuition.library',0
  1444. InputName    dc.b        'input.device',0
  1445. STitle        dc.b        'Save Screen as...',0
  1446. WTitle        dc.b        'Save Window as...',0
  1447. RTitle        dc.b        'Save Rectangle as...',0
  1448. ScrTitle    dc.b        'PicSaver V1.1 1991 by Preben Nielsen',0
  1449.         EVEN
  1450.  
  1451. IDCMP_Flags    =        GADGETUP|ACTIVEWINDOW
  1452. Other_Flags    =        NOCAREREFRESH|ACTIVATE|RMBTRAP|WINDOWDEPTH|WINDOWDRAG
  1453. WW        =240
  1454. WH        =64
  1455. NW        dc.w        300,200-WH,WW,WH
  1456.         dc.b        0,1
  1457.         dc.l        IDCMP_Flags,Other_Flags,GadgetList,0,0,0,0
  1458.         dc.w        0,0,0,0,WBENCHSCREEN
  1459. GadgetList
  1460. Gad1        Gadget        Gad2,56,30,FWIDTH,FHEIGHT,GADGHCOMP,RELVERIFY,STRGADGET
  1461.         Gadget2        FBorder,0,ITxtFile,0,FileInfo,ActivateFS-GJ,0
  1462. Gad2        Gadget        Gad3,15,46,BWIDTH,BHEIGHT,GADGHCOMP,RELVERIFY,BOOLGADGET
  1463.         Gadget2        BBorder,0,ITxtPos,0,0,DoSave-GJ,0
  1464. Gad3        Gadget        0,151,46,BWIDTH,BHEIGHT,GADGHCOMP,RELVERIFY,BOOLGADGET
  1465.         Gadget2        BBorder,0,ITxtNeg,0,0,DoCancel-GJ,0
  1466.  
  1467. FileInfo    dcb.b        si_SIZEOF,0
  1468.  
  1469. FWIDTH        =173
  1470. FHEIGHT        =11
  1471. FBorder        Border        -6,-3,1,0,1,9,FVectors,0
  1472. FVectors    dc.w        2,0,FWIDTH+1,0,FWIDTH+3,2,FWIDTH+3,FHEIGHT-1,FWIDTH+1,FHEIGHT+1,2,FHEIGHT+1,0,FHEIGHT-1,0,2,2,0
  1473. BWIDTH        =74
  1474. BHEIGHT        =11
  1475. BBorder        Border        -2,-1,1,0,1,9,BVectors,0
  1476. BVectors    dc.w        2,0,BWIDTH+1,0,BWIDTH+3,2,BWIDTH+3,BHEIGHT-1,BWIDTH+1,BHEIGHT+1,2,BHEIGHT+1,0,BHEIGHT-1,0,2,2,0
  1477.  
  1478. ITxtSize    IntuiText    1,0,1,-43,-15,TxtSize,0
  1479. ITxtFile    IntuiText    1,0,1,-43,0,TxtFile,ITxtSize
  1480. ITxtPos        IntuiText    1,0,1,21,2,TxtPos,0
  1481. ITxtNeg        IntuiText    1,0,1,14,2,TxtNeg,0
  1482. TxtSize        dc.b        'Size:    0 x    0 x  0',0
  1483. TxtFile        dc.b        'File',0
  1484. TxtPos        dc.b        'Save',0
  1485. TxtNeg        dc.b        'Cancel',0
  1486.         EVEN
  1487.  
  1488. ITxtAUTOBody    IntuiText    AUTOFRONTPEN,AUTOBACKPEN,AUTODRAWMODE,8,4,TxtAUTOBody,0
  1489. ITxtAUTOOk    IntuiText    AUTOFRONTPEN,AUTOBACKPEN,AUTODRAWMODE,6,3,TxtAUTOOk,0
  1490. TxtAUTOBody    dc.b        "PicSaver: Can't write file",0
  1491. TxtAUTOOk    dc.b        ' Ok ',0
  1492.  
  1493. TxtAttr        dc.l        FontName
  1494.         dc.w        TOPAZ_EIGHTY
  1495.         dc.b        FS_NORMAL,FPB_ROMFONT
  1496. FontName    dc.b        'topaz.font',0
  1497.         END
  1498.  
  1499.